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»Oex2000 - DbsOl 

* Revision 2.0.0 

*Body Detection and MeasuremSITu' Algorithms 
'Copyright (c) Leggett & Piatt, Inc. 1999 

'Written by David B. Scott APPENDIX A 

Option Explicit - 

Dim fsa_cb As Integer 

Dim fsa_is As Integer 

Dim fsa_bf As Integer 

Dim fsa_tf As Integer 

Dim fsa_ss As Integer 

pirn PSW As Double 

Dim PHW As Double 

Dim Barray{0 To 2000) As Long 

Dim NewData As Variant 

'Storage for easier reference later 

Dim NumRows As Long 

Dim NumColumns As Long 

■■•Dim:St:Qplt 'As'-Integer ; . ■■ ' "''"-r^ . ■ 

Dim Head As' Integ.^r ' ' . ■ ■ ■ \ , 

Dim Feet As Integer 
Dim FSASum As Double 
Dim FSAAverage As Double 
Dim ESASensors As Long 
Dim S'h'oulderWidth As Double- 
Dim BpAWeight As Double 
Dim ilAHeight As Double 
Dim EpAIspring As Double 
Dim datacall As Long 
ConstgMARRAY As Integer = 10 
PrivaSe Type Coefs 
^.J:coef f icients 

B¥coefa(l To MARRAY) As Double 
C!Bcoefa(l To MARRAY) As Double 
iicoefad To ^4ARRAY) As Double 
iScoefad To MARRAY) As Double 
||profa(l To MARRAY) As Double 
End "f^e 

Dim glrray As Ccefs 

Dim dgndex As Integer 

'ArrJ!^. transfer from Pad Data 

Public Function Put_FSAData {ByVal element As Long, ByVal*index As Long) As Double 
Dim i As Integer 
Dim X As Double 

. On- Error Resume Next. ■ ... ■ • ■ ■ 

"Put_FSAData = '-1 ■ - ' 

If index < 0 Then Exit Function 

If index > 2000 Then Exit Function 

NewData = True 

X = 0 

Barray (index) = element 

If element Then datacall = datacall + 1 
For i = 0 To index 

X = X + Barray(i) 
Next i 

Put_FSAData = x 

If index = 1023 Then 

Crunchit 
End If 
End Function 

'send cb value when requested 
Public Property Get CBcoef () As Variant 
Dim atemp As Double 
Dim j As Integer 
On Error Resume Next 
If NewData Then 
Call Crunchit 
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Dim StartPoint As POINTAPI 





Dim EndPoint As POINTAPI 
Dim MaxRow As Long 
Dim MaxCol As Long 
Dim Cornerl As POINTAPI 
Dim Corner2 As POINTAPI 
'Storage for tracking the mouse 
Dim px As Long 
Dim py As Long 
' Storage for the zoom values 
Dim XStart As Double 
Dim YStart As Double 
Dim XEnd As Double 
Dim YEnd As Double 
Dim St art Row As Long 
Dim EndRow As Long 
Dim StartCol As Long 
Dim EndCol As Long 
Dim Val As Double 
Dim Distance As Long 

'T^jLjcdata window stuff 
Dilg AuxSensors As Long 



Dxwi ShoulderAverage As Double 
Dili ShoulderWidth As Double 
Ddfii HipAverage As Double 
Dim Waist Average As Double 
Dim HipMaxWidth As Double 
Dim WAve rage Width As Double 
Dim FSAWeight As Double 
Dim FSAHeight As Double 
Dim FSAI spring As Doiible, 
Dim TorsoLength As Double 



Private S\ib Chart3Dl_DblClick ( ) 
'Capture the double click. 

Doubleclick = True 
End Sub 

Private Sub Chart3Dl_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single) 
'Watch for the user to press the mouse button so we can create the 
' data rectangle to use for the zoom process. 

'Make sure it is the left button and then get the needed information 
If Button = 1 And Shift = 0 Then 




'C^„erall window stuff 
Di\P FSASum As Double 
Diln FSAAverage As Double 
DiW FSASensors As Long 
DiiS TorsoAverage As Double 
DdSfl TorsoSensors As Integer 



Chart3Dl . Refresh 

'Get the API information from the main Chart 
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ChartDc = GetDC (Cj^^3Dl . hWnd) 

PenHandle = Creat5BR(0, 2, QBColor(O)) 
OldPenHandle = SelectObject (ChartDc , PenHandle) 
Result = SetR0P2 (ChartDc, vbNotXorPen) 

'Get the number of rows and columns in use 
MaxRow = Chart 3D1 . ChartGroups ( 1 ) . Elevat ionData . RowCount 
MaxCol = Chart 3D1 . ChartGroups ( 1 ) . Elevat ionData . ColumnCount 



'Get the pixel co-ordinates of the lower-left and upper-right corners of the 
' main chart so we can constrain the "Rubber Band" to stay on the data area 
Chart 3D1. ChartGroups (1) .DatalndexToCoord 1, 1, Cornerl.x, Cornerl.y 
Chart3Dl ; ChartGroups (1) .DatalndexToCoord MaxRow, MaxCol, Corner2 .x, Corner2 .y 

px = X / Screen. TwipsPerPixelX 'Convert the mouse location to pixels 

py = y / Screen. TwipsPerPixelY 

•If we are outside the chart, set the values to be outside the allowable range 
If px < Cornerl.x Or px > Corner2 . x Then 

StartPoint.x = -1 : ■ 

StartPoint.y = -1 

EndPoint.x = -1 

EndPoint.y = -1 

•Release the resources as we no longer need them 
Result = SelectObject (ChartDc, OldPenHandle) 
Result = DeleteObject (PenHandle) 
Result = ReleaseDC{Chart3Dl.hWnd, ChartDc) 
Exit Sub 
End If 

If py < Corner2.y Or py > Cornerl.y Then 
StartPoint.x = -1 
StartPoint.y = -1 
EndPoint.x = -1 
EndPoint . y = - 1 

•Release the resources as we no longer need them 
Result = SelectObject (ChartDc, OldPenHandle) 
Result = DeleteObject (PenHandle) 
Result = ReleaseDC(Chart3Dl.hWnd, ChartDc) 
Exit Sub 
End If 

•Set the startpoint of the rectangle to the current mouse position 
StartPoint.x = px 
StartPoint.y = py 
EndPoint . x px 
EndPoint.y = py 

'Draw the "Riibber Band" rectangle 

Result = Rectangle (ChartDc, StartPoint.x, StartPoint.y, EndPoint.x, EndPoint.y) , 

'Release the resources as we no longer need them 
Result = SelectObject (ChartDc, OldPenHandle) 
Result = DeleteObject (PenHandle) 
Result = ReleaseDC(Chart3Dl.hWnd, ChartDc) 



Region = ChartSDl . ChartGroups (1) . CoordToDataCoord (StartPoint .x, StartPoint.y, XStart, YS 
tart, Val) 

Region = Chart3Dl. ChartGroups (1) .CoordToDataIndex(px, py, Row, Col, Distance) 'Get the D 
ata Values at the current location 
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NewData = False 
End If 
atemp = 0 
For j = 1 To MARRAY 

atemp = atemp + carray.CBcoefa ( j ) 
Next j 

CBcoef = Format$ (atemp / MARRAY, "0") 
End Property 

'send is val when requested 

Public Property Get IScoef () As Variant 

Dim atemp As Double 

Dim j As Integer 

On Error Resume Next • - 

If NewData Then 

Call Crunchit 

NewData = False 
End If 
atemp = 0 

For j = 1 To MARRAY 

va'temp ' = atemp- +■ carray V ISddef a ( j-)- 
Next j 

IScoef = Format$ (atemp / MARRAY, "0") 
End Property 

*send bf value when requested 

Publlg Property Get BFcoefO As Variant 

Dim aJt^mp As Double 

Dim ji^s Integer 

On Er^'ti^r Resume Next 

If Ne^ata Then 

Otll Crunchit 

I^&wData - False 
End Ml 
atemgo= 0 

For 1 To MARRAY 

^^mp = atemp + carray . BFcoef a (j ) 
Next ^ 

3Fcoe-^= Format$ (atemp / MARRAY, "0") 
End B^9operty 

*sendJtf value when requested 
Publi[g Property Get TFcoef () As Variant 
Dim ^i^mp As Double 
Dim f'^As Integer 
On Error Resume Next 
If NewData Then 
Call . Crunchit 
• .:NewData; =■ F.alse: ■ . .. ■ - ■ 
End Tf 
atemp - 0 

For j = 1 To MARRAY 

atemp = atemp + carray . TFcoef a ( j ) 

Next j 

TFcoef = Format$ (atemp / MARRAY, "0") 
End Property 

*send spine position when requested 

Public Property Get SSprof () As Variant 

Dim atemp As Double 

Dim j As Integer 

On Error Resume Next 

If NewData Then 

Call Crunchit 

NewData = False 
End If 
atemp = 0 

For j = 1 To MARRAY 

atemp = atemp + carray . SSprof a (j ) 
Next j' 

SSprof = Format$ (atemp / MARRAY, "0") 
End Property 
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'Actual Mathmatics for Body ^^^^ction and Measurements 
Private Sub CrunchitO 

Dim r As Integer 

Dim c As Integer 

Dim InARow As Integer 

Dim DTemp As Double 

Dim fsa As Integer 

Dim darray(32, 32) As Double 

Dim Lumbar As Double 

Dim CrotchHeight As Integer 

Dim CDatad To 32, 1 To 32) 

Dim UnitMultiplier As Double 

Dim Filter As Double 

Dim Center As Integer 

Dim Cfirst As Integer 

Dim TorsoCenter As Integer 

Dim WaistCenterSum As Integer 

Dim WaistAverage As Double 

Dim Filter2 
. ■ ■Qri- Error 'ResumLe Next ■ : ; . : ■;: 

UnitMultiplier = 0.392156862745098 



fsa = 0 
E::aASum = 0 
E*g\Sensors = 0 

^MmColumns = 32 
N^^nRows = 32 

Filter =0.75 
Ep.ter2 = 2 

Vl^code one-dimensional data into three-dimensional form 
tcr c = 1 To NumColumns 
For r = 1 To NumRows 

r " 

•^P DTemp = Barray(fsa) * UnitMultiplier 

p CData(c, r) = DTemp 

Vl If DTemp > Filter Then 

fZ^ FSASum = FSASum + DTemp 

i;r If DTemp > Filter2 Then FSASensors = FSASensors + 1 

End If 
fsa = fsa +1 
Next r 

Next c 

If FSASensors" = 0 Then GoTo no_body 
'*Compute'Sensor Average Pressure 
FSAAverage = FSASum / FSASensors 

* Compute theoretical weight 
FSAWeight = FSASum * 0.0155 

' if the person is less than 40 lbs - abort 
If FSAWeight < 40 Then GoTo no_body 

* set up first cb factor.. 
fsa_cb = FSAWeight * 3.5 

•Find the Head or top active sensor 
Stopit = False 
For c = 1 To NumColumns 
For r = 1 To NumRows 

If CData(c, r) >, Filter2 Then Stopit = True 
If Stopit Then Exit For 
Next r 

If Stopit Then Exit For 
Next c 
Head = c 

'Find the feet or bottom active sensor 
Stopit = False 

For c = NumColumns To 1 Step -1 
For r = NumRows To 1 Step -1 



DbsOl - 4 

If CData(c, r) >^|^ter2 Then Stopit = True 
If Stopit Then E^^PFor 
Next r 

If Stopit Then Exit For 
Next c 
Feet = c 

'Calculate estimated Height based on Head & Feet detection 

FSAHeight = (2 + (Feet - Head)) * 2.25 

If FSAAverage =0 Then GoTo error_out 
'select crotch height/shoulder width based on calculated height 
'from statistical ave values 

Select Case (2 + (Feet - Head)) 'note '#of sensor rows not inches 

Case 25 

CrotchHeight = 11 

ShoulderWidth = 19 
Case 26 

CrotchHeight = 12 

ShoulderWidth =20 
Case 27 

CrotchHeight-'- 12 y': ' ^ % i '-^^ \' .. 

ShoulderWidth = 21 " ' ^ 
Case 28 

CrotchHeight = 13 
ShoulderWidth = 22 
C^e 29 
■'^ CrotchHeight = 13 
ShoulderWidth = 24 
ctfle 30 
=5 CrotchHeight = 14 
^ ShoulderWidth = 24 
C^e 31 

CrotchHeight = 14 
ShoulderWidth = 25 
Caie 32 

CrotchHeight = 15 
Q ShoulderWidth =26 
C^e 33 
□ CrotchHeight = 15 
=Ij ShoulderWidth = 27 
C^e 34 

CrotchHeight = 15 
W ShoulderWidth = 27 
Case 34 

CrotchHeight = 15 
ShoulderWidth = 27 
■'■ C^se Else'"" .\ ' ^ - 

CrotchHeight =31 
ShoulderWidth = 31 
End Select 

' inter spring value set based on f sa ave weight 
FSAIspring = FSAWeight / FSAAverage 
fsa_is = FSAIspring * 100 

'look for top of shoulders (not used at this time) 

Stopit = 0 

InARow = 0 

For c = 1 To 16 

If c > 32 Then GoTo error_out 
If c < 1 Then GoTo' error_out 
For r = 1 To NumRows 

If CData{c, r) > Filter Then 
InARow = InARow + 1 

If InARow < Stopit Then Stopit = InARow 
Else: InARow = 0 
End If 
Next r 

If Stopit < 12 Then Exit For" '12 in a row is down past the head 

■ Stopit = 0 
Next c 
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'look for center of shodj^rs (not used at this time) 
If c < 1 Then c = 1 
Center = 0 
Cfirst = 0 
Stppit = False 
For r = 1 To NumRows 

If CData{c, r) > Filter Then 
Center = Center + 1 
If Cfirst = 0 Then Cfirst = r 

End If 
Next r 

fsa_bf = (((FSAWeight / ShoulderWidth) ) * 45) 
Center =0 - " 

Cfirst = 0 
Stopit = False 
* f ind center of hips 
c = CrotchHeight + 1 
For r = 1 To NumRows 

If CData(c, r) > Filter Then 
■■ / Cehteir^'=.: Center _ " V/; 

If ■ Cfirst = 0 Then ' Cfirst = r ' ' 

End If 
Next r 

TorsoCenter = Cfirst + (Center / 2) 
W^stCenterSum = 0 

'"iri^ok at the lumbar area for weight 
E^r c = CrotchHeight - 2 To CrotchHeight 

For r = TorsoCenter - 5 To TorsoCenter + 5 
Ifc-4<1 Then GoTo error_out 
=:p . WaistCenterSum = WaistCenterSum + CData(c - 4 

i:n Next r 
N^jct c 
*^^nd lumbar 

W^istAverage = (WaistCenterSum / 33) / FSAAverage 
IiUitibar = WaistAverage 
ISa_tf = Lumbar * 100 
f^ ss = 0 
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GoTo end_sub 
*if min wieght is not meet the return O's 
no_body : 

fsa_cb = 0 

fsa_is = 0 
.fsa_bf = 0 

fsa_tf = 0 

fsa_ss = 0 

GoTo end_sub 
*if error return default numbers 
error_out : 

fsa_cb = 300 

fsa_is = 500 

fsa_bf = 255 

fsa_tf = 100 

fsa ss = 5 



end sub: 



carray.CBcoefa (cindex) 
carray , IScoefa (cindex) 
carray . BFcoefa (cindex) 
carray .TFcoefa (cindex) 



fsa 
fsa 
fsa 
fsa 



_cb 
is 
bf 
"tf 
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carray . SSprofa (cindex) ^^a_ss 

cindex = cindex + 1 

If cindex > MARRAY Then^Rdex = 1 

Exit Sub 
End Sub 

Private Sub Class_Initialize ( ) 

'setup coefficent arrays to 0 

Dim i As Integer 

For i = 1 To MARRAY 

carray . BFcoef a (1) = 0 
carray. CBcoefa (i) = 0 
carray . IScoefa (i) = 0 
carray . SSprofa (i) =0 
carray. TFcoef a (i) = 0 

Next i 

cindex = 1 
End Sub 



^3 
^4 
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'Store the row ar^^^lumn values for use in the sub-set creation later 
StartRow = Row 
Started = Col 



End If 
End Sub 

Private Sub Chart 3 Dl_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single) 
•Track the movement of the mouse and update the "Rubber Band" rectangle. 

If Button = 1 And StartPoint.x <> -1 And Shift = 0 Then 

'Get the API information from the main Chart 
ChartDc = GetDC (Chart 3D1 .hWnd) 
PenHandle - CreatePen(0, 2, QBColor(O)) 
OldPenHandle = SelectObject (ChartDc, PenHandle) 
Result = SetR0P2 (ChartDc, vbNotXorPen) 



in 



•Get rid of the old rectangle 

Result = Rectangle (ChartDc, StartPoint.x, StartPoint .y, EndPoint.x, EndPoint . y) 

•Convert the screen co-ordinates ■ to pixels 
px = X / Screen. TwipsPerPixelX 
py = y / Screen. TwipsPerPixelY 



'Constrain the "Rubber Band" rectangle to stay on the data area of the chart 
If px >= Cornerl.x And px <= Corner2.x Then 
EndPoint . x = px 

Else 

If px < Cornerl.x Then 

EndPoint.x = Cornerl.x 

Else 

EndPoint . x = Corner 2 . x 
□ End If 

^4 End If 

13 If py >= Corner2.y And py <= Cornerl.y Then 
p EndPoint.y = py 

Else 

If py > Cornerl.y Then 

EndPoint.y = Cornerl.y 

Else 

EndPoint . y = Corner2 . y 

End- If ' . . , ' ■^ ^''^/V-- 

. ^. . , , , ....... . ..^ ■ . . .... , 

'Draw the new rectangle 

Result = Rectangle (ChartDc, StartPoint.x, StartPoint .y, EndPoint.x, EndPoint.y) 

•Release the resources as we no longer need them 
Result = SelectObject (ChartDc, OldPenHandle) 
Result = DeleteObject (PenHandle) 
Result = ReleaseDC(Chart3Dl.hWnd, ChartDc) 
End If 
End Sub 



Private Sub Chart3Dl_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single) 
'Capture the mouse up event so we know when the user is done creating the rectangle. 
'Copy the current graph to one of the empty locations, and then perform the zoom. 



Static i As Integer 
Static J As Integer 
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1 

Dim hd As Integer 
Dim hid As Boolean 

hd = -1 

» Check and make sure there is data to zoom in on first and exit if there isn't any selected 
If Abs (StartPoint .X - EndPoint.x) < 1 Or Abs (StartPoint . y - EndPoint.y) < 1 Then 

•Get the API information from the main Chart 
ChartDc = GetDC (Chart3Dl .hWnd) 
PenHandle = CreatePen(0, 2, QBColor(O)) 
OldPenHandle = SelectObj act (ChartDc , PenHandle) 
Result = SetR0P2 (ChartDc, vbNotXorPen) 

' Clear the rectangle 

Result = Rectangle (ChartDc, StartPoint , x, StartPoint .y, EndPoint.x, EndPoint.y) 

'Release the resources as we no longer need them 
Result = SelectObject (ChartDc, OldPenHandle) 
Result = DeleteObject (PenHandle) 
Result = ReleaseDC(Chart3Dl.hWnd, ChartDc) 
Exit Sub 
OEnd If 

iUlf Button = 1 And StartPoint. x <> -1 Then 

'-f^ 'Get the API information from the main Chart 

^,0 ChartDc = GetDC (Chart 3 Dl . hWnd) 

in PenHandle = CreatePen(0, 2, QBColor(O)) 

Co OldPenHandle = SelectObject (ChartDc, PenHandle) 

s Result = SetROFl:; (ChartDc, vbNotXorPen) 

I 3 

,5 'Get rid of the old rectangle 

Result = Rectangle (ChartDc, StartPoint .x, StartPoint .y, EndPoint.x, EndPoint.y) 

f^, px = X / Screen. TwipsPerPixelX 'Convert screen co-ordinates to pixels 

fi: Py - y / Screen. TwipsPerPixelY 

'Constrain the "Rubber Band" rectangle to the data area of the chart 
If px >= Cornerl.x And px <= Corner2.x Then 
EndPoint.x = px 

Else 

. If px < Cornerl.x Then . 
EndPoint.x = Cornerl.x 

Else 

EndPoint.x = Corner2.x 
End If 
End If 

If py >= Corner2.y And py <= Cornerl.y Then 
EndPoint.y = py 

Else 

If py > Cornerl.y Then 

EndPoint.y = Cornerl.y 

Else 

EndPoint . y = Corner 2 . y 
End If 
End If 

'Draw the new rectangle 

Result s= Rectangle (ChartDc, StartPoint .x, StartPoint .y, EndPoint.x, EndPoint.y) 
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'Capture values fo^^^e in the creation of the subset^Jfer 

Region = Chart 3 Dl .^^Kt Groups ( 1) . CoordToDataCoord (EndPoint . x, EndPoint.y, XEnd, YEnd, Va 

1) 

Region = ChartSDl . ChartGroups (1) . CoordToDatalndex (EndPoint ,x, EndPoint.y, Row, Col, Dist 
ance) 'Get the Data Values at the current location 

If Region = oc3dRegionInChartArea Then 

EndRow = Row 

EndCol = Col 
End If 



• Clear the rectangle 

Result = Rectangle (ChartDc, StartPoint . x, StartPoint .y , EndPoint.x, EndPoint.y) 

'Release the resources as we no longer need them 
Result = SelectObject (ChartDc, OldPenHandle) 
Result = DeleteObject (PenHandle) 
Result = ReleaseDC (Chart 3D1 .hWnd, ChartDc) 

Debug. Print StartRow; StartCol; EndRow; EndCol 

'Switch around the rows and cols to make things easier 
If StartRow > EndRow Then 
h'^ i = StartRow 

StartRow = EndRow 
EndRow = i 
"5 End If 

fl If StartCol > EndCol Then 

i = StartCol 

StartCol = EndCol 

EndCol = i 
=H End If 

'j. AuxSensors = 0 
O' AuxSum = 0 

For i = StartCol To EndCol 

For J = StartRow To EndRow 

If Char t 3D1. ChartGroups (1) .ElevatiohData. Value (J, i) > 0 Then 

AuxSum = AuxSum + Chart 3D1 . ChartGroups (1) . ElevationData .Value (J, i) 
AuxSensors = AuxSensors + 1- . , , ' 

'■" ' ''End'lf '■■ ' " ■'■ ■ ■ i ■• ^ ^ ■ 

Next J 
Next i 

If Len (CommonDialogl . filename) > 0 Then 
AuxWidth = Abs(YEnd - YStart) 
AuxLength = Abs (XEnd - XStart) 
AuxAverage = AuxSum / AuxSensors 



'Reset the location of the highlighted area 

End If 
End If 
End Sub 



Private Sub Commandl_Click { ) 
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M^^fecoef = 0 Or Me.IScoef = 0 Or Me^T^i 



If Me.BFcoef = 0. Or M^^Bcoef = 0 Or Me.IScoef = 0 Or MevTFcoef = 0 Then 

EntryError.ErrorText .Caption = "You must have a FSA file or manually entered data to pro 

ceed" 

EntryError . Show 1 
Exit Sub 
End If 



Main. Show 1 
End Sub 



Private Sub Command2_Click ( ) 

GoExcel 
End Sub 

Private Sub Form_Load() 

'This is where it all begins! 

Frame2 .Enabled = False 

p' Start with the form in the top-left corner 
iQMe.Top = 50 
[SMe.Left = 50 

' Setup the need variables 
i.hDim r As Integer 
iSDim c As Integer 
ffiDim AxisValue As Double 
^'Dim delta As Double 

These are backwards so because the grid is the main problem 
' to contend with- due to all the inversion necessary 
j-'iNumRows = Chart3Dl.ChartGroups (1) . ElevationData . ColumnCount 
^^NumColumns = Char t 3 Dl . Chart Groups { 1) . ElevationData. RowCount 

' Set a default value 
Doubleclick = False 

•This puts the values of the Grid Index points into the header row 

' of the grid control. (grid control is at the bottom of the window) 

VNOTE : . Becuase of , the rbtation of the graph, the columns and rows . are 

• reversed in order to fill the grid in correspondance with the graph 

delta = Chart3Dl.Char.tGroups{l) .ElevationData. RowDelta(l) 

AxisValue = Chart 3D1 . ChartGroups (1) . ElevationData .RowOrigin 

•This puts the values of the Grid Index points into the header column 
' of the grid control, (grid control is at the bottom of the window) 
'NOTE: Becuase of the rotation of the graph, the columns and rows are 
' reversed in order to fill the grid in correspondance with the 

' chart 

delta = Chart3Dl.ChartGroups(l) .ElevationData. ColumnDeltad) 
AxisValue = Chart3Dl . ChartGroups (1) .ElevationData .ColumnOrigin 

' Change the color of the Grid Lines 

Chart 3D1 . Chart Area .Axes ( "X" ) . Ma jorGrid. Style . Color = ocColorCornf lowerBlue 

Chart3Dl . ChartArea . Axes ( "Y" ) .Ma jorGrid. Style . Color = ocColorCornf lowerBlue 

Chart3Dl.ChartArea.Axes ("Z") . Ma j orGrid. Style . Color = ocColorCornf lowerBlue 
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End Sub 

Private Sub Form_Unload (Cancel As Integer) 
' End the progratn . 

End 
End S\ib 



Private Sub mnuAbout_Click ( ) 

'User wants to see what to do in this demo. 

With ConimonDialogl 

.HelpCommand = cdlHelpContext 
.HelpContext =18 
.HelpFile = App.HelpFile 
. ShowHelp 
■ End .with' 
End Sub 

PrfSate Sub TnnuAbout01ectra_Click { ) 

'Usir wants to see what Olectra Chart 3D is all about. 

=:pWith CommonDialogl 

=;E .HelpCommand = cdlHelpContext 

.HelpContext = 19 
in .HelpFile - App.HelpFile 
[0 .ShowHelp 
^End With 
En|^Sub 

PriW^ate Sub mnuExit_Click { ) 
'Exit the program. 

!S Unload Me 
EnSrS\ab 



Private Sub mnuOpen_Click ( ) 

Dim sFile As String ' ,: . , 

With CommonDialogl 
. filename = " " 
.Flags = 0 
'To Do 

' set the flags and attributes of the 
' common dialog control ' 
..Filter = "FSA Files (*,FSA)|*.*" 
. ShowOpen 

If Len( .filename) = 0 Then 

Exit Sub 
End If 

sFile = . filename 
End With 

' cancel = CommonDialogl .Action 
Crunchit (sFile) 
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End Sub 

Private Sub Crunchit (sFilel^^String) 

Dim r As Integer 

Dim c As Integer 

Dim RAv As Double 

Dim avrav As Double 

Dim InARow As Integer 

Dim TorsoBottom As Integer 

Dim TorsoTop As Integer 

Dim TorsoLeft As Integer 

Dim TorsoRight As Integer 

Dim Brow As Integer 

Dim HipSum As Double 

Dim WaistSum As Doiible 

Dim HipSensors As Integer 

Dim WFirst As Integer 

Dim WLast As Integer 

Dim Last InARow As Integer 

Dim ShoulderSum As Double 

Dim ShoulderSensors As Integer 

Dim SLast As Integer 
QDim SFirst As Integer 
ugDim Stretch As Integer 
In Dim WaistSensors As Integer 
pDim DTemp As Double 
j^Dim TorsoCenter As Double 
,kDim test As Variant 

7^ ReadFile (sFile) 

L Chart 3 Dl . IsBatched = True 

f sa = 0 
FSASum = 0 
FSASensors = 0 

O 'fill in the chart region - batched 

For c = 1 To NumColumns 
For r = 1 To NumRows 

..^ DTemp = VistaFile , FSAData (f sa) * VistaFile .UnitMultiplier . 

Oex2000.Put_FSAData VistaFile . FSAData (fsa) , fsa 

Chart3Dl.ChartGroups(l) .ElevationData. Value (c, r) = DTemp 

fsa = fsa + 1 
Next r 

Next c 

ChartSDl. IsBatched = False 
BFcoef.Text = Oex2000 .BFcoef 
CBcoef.Text = Oex2000 . CBcoef 




TFcoef .Text 



= Oex2000 .TFcoef 



frmSurface - 10 



IScoef.Text = Oex200 




!oef 




SSprof.Text = Oex2000 . SSprof 

Dim holderl, holder2, holder3 As Double 

If Optionl(O) .Value = True Then 

HeadZone , Text = Format (Oex2 000 . FSAWeight * 0.11, "00") 

holderl = {Oex2000 . FSAWeight * 0.55) 

holder2 = Oex2 000 .ShoulderAverage + Oex2000 .WaistAverage + Oex2000 .HipAverage 

holders = 100 - holder2 

If holders < 0 Then holders = -holders 

holders = holders / 2 

ShoulderZone.Text = Format (holderl * ( (Oex2000 . ShoulderAverage + holders) / 100), "00") 
C3 WaistZone.Text = Format (holderl * ( (Oex2000 .WaistAverage) / 100), "00") 
Lfl HipZone.Text = Format (holderl * ( (Oex2 000 . HipAverage + holders) / 100), "00") 

ThighZone . Text = Format (Oex2 000 . FSAWeight * 0.2, "00") 
m FeetZone.Text = Format (Oex2000 .FSAWeight * 0.1, "00") 



End Sub 

Private Sub Opt ionl_Click (index As Integer) 

If index = 1 Then Frame2 .Enabled = True Else: Frame2 . Enabled = False 

End Sub 

Private Sub Utility_Click() 
Main. Show 1 



flElse 



End If 



frmSurface .'Caption 



= "L&P Controls FSA Statistic Tool - " ' + sFile 



End Sub 



V 



frmSurface - 11 

Public Sub GoExcelO 

Set xlApp = CreateObject { "Excel -Application" ) 

Set xlBook = xlApp. Worlcbooks .Add 

Set xlSheet = xlBook. Worksheets (1) 

xlApp. Visible = True 

xlSheet .Cells (1, 1) 

xlSheet .Cells (1, 2) 

xlSheet. Cells (1, 3) 

XlSheet. Cells (1, 4) 

xlSheet .Cells (1, 5) 

Dim sFile As String 
Dim i As Integer , 



For i = 1 To 79 
£3 If i < 10 Then 
^ sFile = "C:\FSADATA\0" & i & ".fsa" 
ifl Else: sFile = "C: \FSADATA\" & i & ".fsa" 
End If 

Crunchit (sFile) 

xlSheet.Cellsd' + 1, 1) = i 
in xlSheet. Cells (i + 1, 2) = Format $ (Oex2 000 . CBcoef, "0") 
(n XlSheet .Cells (i + 1, 3) = Format$ (Oex2000 . IScoef , "0") 
1" xlSheet. Cells (i + 1, 4) = Format$ {Oex2000 .BFcoef , "0") 
n XlSheet. Cells (i + 1, 5) = Format $ (Oex2 000 . TFcoef , "0") 

^'jNext i 

^5 xlSheet . SaveAs ( "FSAconversion" ) 
^=^xlApp.Quit 




= "Subject" 
= "CB" 
= "IS" 
_ II BF" 



End Sub 



Home - 1 

Private Done As Integer 

Private Sub Form_Load() 

Done = False 
DoEvents 
Call ApiHome 

Done = True 
End Sub 
Private Sub Timerl_Timer ( ) 

Dim Complete As Long 

If ProgressBarl .Value = 100 Then 

ProgressBarl .Value =0 
Timerl . Enabled = False • 
Complete = ApiComplete (0 , "HOME") 
If Complete = &HAABFF Then 

Status .Caption = "Complete" 
Unload Me 
Exit Sub 
End If 

Timerl . Enabled = True 
fOEnd If 

QProgressBarl .Value = ProgressBarl .Value 
EndPSub 




5 ?^ 



m 



APPENDIX B 



Dim xlBook As Excel .Workbook 

Dim xlSheet As Excel .Worksheet 

Dim XI As Double 

Dim X2 As Double 

Dim x3 As Double 

Dim x4 As Double 

Dim x5 As Doiible 

Dim x6 As Double 

Dim x7 As Double 

Dim x8 As. Double 

Dim x9 As Double ' ■ ' 

Dimt^pineData As Double 
Dini'f$topit As Integer 
Dim'plead As Integer 
DiT^L^eet As ' Integer 

■'Indices of last grid index selected 

DiitfSjastRow As Long 

Dir|i!LiastCol As Long 

Corisrt NumHold As Integer = 3 

' Irfdices of the current grid index being dragged 
DirftjPickRow As Long 
DimhPickCol As Long 

'St:'drage for easier reference later 
DiiiSNumRows As Long 
DiriSNumColumns As Long 

'True when rotating, etc. 
Dim IsModifying As Boolean 

•Keeps track of the region the mouse is in 
Dim Region As Long 
Dim OldRegion As Long 

'Keeps track of the current row and column the mouse is on 
Dim Row As Long 
Dim Col As Long 

'ASCII Character constants 
Const CharEnter As Integer = 13 

'Capture any double-clicks the user does 
Dim Doubleclick As Boolean 

Public fsa As Long 

'Storage for drawing the zoom rectangle 
Dim Result As Long 
Dim PenHandle As Long 
Dim OldPenHandle As Long 
Dim ChartDc As Long 



frmSur.face - l 

Option Explicit 
Dim PHW As Double 
Dim PSW As Double 



Dim xlApp As Excel .Application 



Instructl - 1 



Option Explicit. 

Private Sub CancelButton_Click ( ) 
Main. Choice = 1 
Unload Me 

End Siib 

Private Sub OKButton_Click ( ) 
Main. Choice = 0 
Unload Me 

End Sub 



r i! 

m 



?. 3=;! 




Main - 



1 




Public Project As Varian^ 
Public ProjectDate As Vai 
Public Choice As Integer 
Public Head As Variant 
Pi±>lic Trunk As Variant 
Public Thighs As Variant 
Public Legs As Variant 
Public Feet As Variant 
Public TestStage Ae Variant 
Public MonitorStage As Variant 

Private Type Oexrecord 

' identity stuff 

Description As String 

pDate As String 

Setup As Integer 

' coefficients 

BFcoef As Double 

CBcoef As Double 
• TFcoef As Double 

IScoef As Double 

SSprof As Double 
O ' zone stuff 
^flHdzone As Doiible 
ins zone As Double 
:.CWzone As Double 
-C Hp zone As Double 
i^QTzone As Double 
[flFzone As Double 
Co ' positional feedback 

Position (1 To 20) As Single 
f2 ' calibration stuff 
^gCalibrationd To 20) As Single 
En#=| Type 

Private oexdata As Oexrecord 



' Home Button 

Private Sub Commandl_Click () 

Home. Show 1 
End Sub 

• Calibrate Button 

Private Sub Command3_Click { ) 

Calibrate. Show 1 

End Sub 

' Reset Button 

Private Sub Command4_Click () 

Re set. Show 1 
End Sub 



' Test Button 

Private Sub Commands Click () 



Main - 2 



Dim filename As VariaSlP 
Dim i As Integer 

If Pro j ectText . Text = Then 

EntryError.ErrorText .Caption = "No Project Entered" 
EntryError .Show 1 
Exit Sub 

End If 

» build the filename with directory and extension 
filename = "\oex2000\" + Pro j ectText . Text + ".oex" 
• verify the existance or lack thereof 
If Dir (filename) = ""Then 



Else 

' file already exists - replace = 0, cancel = 1 
Ifl FileError . Show 1 

If Main. Choice = 1 Then Exit Siib 

l"f|End If 

' if we get here we have an open file "filename" 
™' and the data has been justified enough to proceed with the test 

%lf Opt i onl (0) .Value = True Then 

J ApiHeadZone f rmSur face .He adZ one .Text * 0.0151 

ApiShoulderZone (f rmSur face . Shoulder Zone .Text * 0.0151) / 3 

O ApiWaistZone (f rmSurf ace. WaistZone. Text * 0.0151) / 4 
ApiHipZone (frmSurf ace .HipZone . Text * 0.0151) / 2 
ApiThighZone (f rmSur face .ThighZone .Text * 0.0151) / 2 
ApiFeetZone (frmSurf ace . Feet Zone .Text * 0.0151) / 2 

End If '.^ ■ ' ' "■.'■■.^ 

Timerl . Enabled = True. 

TestStage = 1 
MonitorStage = 1 




' retract to zero start - home if not initialized 
Status .Caption ^= "Initializing. . . " 
DoE vents 
Call ApiRetract 

wait_Retract : 

DoEvents 

If ApiComplete{0, "RETRACT") <> &HAABFF Then GoTo wait_Retract 



Main - 3 

Timerl . Enabled = Fals( 
Instructl .Show 1 
If Main. Choice = 1 Then Exit Sub 
Timerl . Enabled = True 

' run the product test now that everytihing is setup 
Status .Caption = "Testing Product..." 
Call ApiTest 




wait Test: 



DoE vents 



If ApiComplete (0, "TEST") <> &HAABFF Then GoTo wait_Test 

• write test data to the open file and complete 

Status .Caption =' "Storing Test Data..." 

Qoexdata. Description = Description. Text 
JRoexdata.pDate = DateText .Text 

only valid one right now 
"f=^oexdata.Setup = 0 

^ P^oexdata . BFcoef 

:'Soexdata . CBcoef 

\H 

i'^oexdata . TFcoef 

= u 

~_ "oexdata . IScoef 

!-oexdata . SSprof 

iJ 

!:^oexdata . Hdzone 
^==^oexdata . Szone 
"^oexdata . Wzone 
^:=:^oexdata . Hpzone 
C3oexdata . Tzone 
oexdata . Fzone 



= BFcoef .Text 
= CBcoef .Text 
= TFcoef . Text 
= IScoef. Text 
= SSprof .Text 



= f rmSurf ace . HeadZone . Text 
= f rmSurf ace . ShoulderZone . Text 
= f rmSurf ace .Waist Zone .Text 

= f innSur face .HipZ one . Text 
= f rmSurf ace . ThighZone . Text 
= f rmSurf ace . FeetZone . Text 



For i = 1 To 10 

oexdata. Position (i) = Axis . FloatValueOf (i , "PFPOS") 
■ oexdata. Calibration (i) = Axi s. FloatValueOf (i,"CAL") 
Next i 



For i = 12 To 20 Step 2 

oexdata. Posit ion (i) = Axis. FloatValueOf (i, "PFPOS") 
oexdata. Calibration (i) = Axis . FloatValueOf {i , "CAL") 

Next i 



'close file after writing all project info 
Open filename For Binary Access Write As #1 



Put #1, 1, oexdata 



Close #1 



Status. Caption = "Test Complete!" 
Timerl. Enabled = False 
ProgressBarl .Value = 100 
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End Sub 

Private Bvh Command7_Click ( ) 

Calibrate . Show 1 
End Sub 

Private Sub Command6_Click ( ) 

EStop.Show 1 
End Sub 

Private Sub Command8_Click { ) 

SetDate.Show 1 
End Sub ~ 
Private S\ib Form_Load() 
%S ApiOpenPort 

=pDateText .Text = SetDate . Calendar 1 .Value 

'combobox is disabled until support can be written 
ifi Combol .Enabled = False 

31 BFcoef.Text = f rmSur face .BFcoef .Text 
pCBcoef.Text = frmSurf ace . CBcoef .Text 
..gTFcoef .Text = f rmSur face .TFcoef .Text 
f=^ IScoef .Text - frmSurf ace . IScoef .Text 
QsSprof.Text = frmSurf ace . SSprof . Text 

I i 

IJOptionld) .Enabled = False 

■"^ Opt ionl (2) .Enabled = False 

Options (1) .Enabled = False 



End Sub 

Private Sub Form_Unload( Cancel As Integer) 

ApiClosePort 
Unload SetDate 

End Sub 

Private Sub Opt ionl_Click (index As Integer) 



ApiSetDrives ( index) 
If Optionl(2) .Value = True Then 

Optionl (2) .Value = False 

Optionl (0) .Value = True 

EntryError.ErrorText .Caption = "Option not yet supported" 
EntryError.Show 1 
End If 
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End Sub 
Private Sub Retract_Click { ) 
Position. Show 1 




End Sub 

Private Sub Summary_Click ( ) 

sum. Show 1 
End Sub 

Private Sub Timerl_Timer ( ) 
If TestStage = 0 Then 
Elself TestStage = 1 Then - 
Elself TestStage = 2 Then 
J^Elself TestStage = 3 Then 

in 

^^End If 

If ProgressBarl. Value = 100 Then 
1^ ProgressBarl .Value = 0 

J;:: End If 

ProgressBarl .Value = ProgressBarl .Value + 1 
EnSL Sub 



Reset - 1 

Private Done As Integer 
Private Sub Form_Load ( ) 

Done = False 

DoEvents 

Call ApiReset 

Done = True 
End Sub 
Private Sub Timerl_Timer ( ) 

Dim Complete As Long 

If ProgressBarl. Value = 10.0 Then 

ProgressBarl .Value = 0 
_„ Timerl. Enabled = False 

?y If Done = True Then 

status. Caption = "Complete" 
Unload Me 

=^ Exit Sub 

End If 

m 

Timerl. Enabled = True 

-pEnd If 

f ^ 

""•^J ProgressBarl .Value = ProgressBarl .Value + 1 
EnESub 




SetDate - 1 

Option Explicit 
Private Sub CancelButton_Click ( ) 

Unload Me 
End Sub 

Private Siib Form_Load() 

Calendarl . Today 
End Sub 

Private Sub OKButton_Click ( ) 

Main. Pro jectDate = Calendarl .Value 
Main . DateText . Text = Main . Pro j ectDate 
Unload Me 

End Sub 

C3 ■ ■ . 




sum - 1 



Option Explicit 

Private Type Oexrecord 

* identity stuff 
Description As String 
pDate As String 
Setup As Integer 

' coefficients 
BFcoef As Double 
CBcoef As Double 
TFcoef As Double 
IScoef As Double 
SSprof As Double 

• zone stuff 
Hdzone As Double 
Szone As Double 
Wzone As Double 
Hpzone As Double 
Tzone As Double 
Fzone As Double 

Q' positional feedback 
iQPositiond To 20) As Single 
in* calibration stuff 
=:ECalibration (1 To 20) As Single 
EncpType 

Private Sub mnuAbout_Click ( ) 

'Ufer wants to see what to do in this demo. 

^Swith CommonDialogl 

.HelpCommand = cdlHelpContext 

.HelpContext = 18 
^2 .HelpFile = App.HelpFile 
ZZ . ShowHelp 
-End With 
End Sub 

Private Sub mnuAbout01ectra_Click () 

'User wants to see what Olectra Chart 3D is all about. 

With CommonDiiaiogl 

.HelpCommand = cdlHelpContext 

.HelpContext =19 

.HelpFile = App.HelpFile 

.ShowHelp 
End With 
End Sub 

Private Sub mnuExit_Click ( ) 
'Exit the program. 

Unload Me 
End Sub 




Private S\ib mnuOpen_Click ( ) 
Dim sFile As String 



sum - 2 



With CommonDialogl 




.filename = "" 
.Flags = 0 
'To Do 

•set the flags and attributes of the 
•common dialog control 
.Filter = "Oex2000 Files (*.OEX)|*.*" 
. ShowOpen 

If Len (, filename) = 0 Then 

Exit Sub 
End If 

sFile = .filename 
End With 

' cancel = CommonDialogl .Action 
Crunchit (sFile) 

End Sub 

Private Sub Crunchit (sFile As String) 
Dim oexdata As Oexrecord 
^UDim i As Integer 

^ROpen sFile For Binary Access Read As #1 
iQoet #1, 1, oexdata 
Co Close #1 

pText3.Text = sFile 

='==1 

OText2.Text = oexdata .Description 

"■'-4 

fjBFcoef .Text = Oex2 000 . BFcoef 
'^'^ CBcoef .Text = Oex2000 . CBcoef 

TFcoef.Text = Oex2000 . TFcoef 

IScoef.Text = Oex2000 . IScoef 

SSprof.Text = Oex2000 .SSprof 



HeadZone .Text = oexdata . Hdzone 
ShoulderZone .Text = oexdata . Szone 
Waist Zone. Text = oexdata. Wzone 
HipZone.Text = oexdata . Hp zone 
ThighZone . Text = oexdata .Tzone 
FeetZone.Text = oexdata. Fzone 

frmSurf ace. Caption = "L&P Controls FSA Statistic Tool - '• + sFile 



For i = 1 To 10 



sum 



- 3 



* Textl (i - 1) .Text 




:data . Position ( i ) 




Next i 

Textl (10) .Text = oexdata. Position (12) 

Textl (11) -Text = oexdata. Position (14) 

Textl (12) .Text = oexdata. Position (16) 

Textl (13) .Text = oexdata . Position (18 ) 

Textl (14) .Text = oexdata . Position (20 ) 



End Sub 

Private Sub Optionl_Click (index As Integer) 

If index = 1 Then Frame2 . Enabled = True Else: Frame2 . Enabled = False 



End Sub 



AxisControl - 2 
Public Sub ApiHomeO 

Axis.ChangeValue All, "HOME", "1.0" 
End Sub 

Public Sub ApiProductO 

Axis.ChangeValue All, "PRODUCT", "1.0 
End iSub 

Public Sub ApiTestO 

Axi s . Change Value Al 1 , " TEST " , "1.0" 
End Sub 

Public Slab ApiRetractO 

Axis . ChangeValue All , "RETRACT" , "1.0 
EndgSub 

in 

Pub^c Sub ApiCalibrate 0 

.TaxIs . ChangeValue All , "CALIBRATE" , " 1 



EndgSub 



Public Sub ApiResetO 

J-CAxis. ChangeValue All, "SWE", "0" 

^^Axis . PgmStop All 
JijAxis .Reset All 
^'=^Axis.ClearPgm (All) 

Axis.LoadPgm All, "MAIN" 

Axis . PgmRun All 

Call ApiSetDrives (0) 
.End Siib ■ : 
Public Sub ApiEstopO 

Axis.EStop All 

DoEvents 
Axis. Reset All 

DoEvents 
Axis.ClearPgm All 

DoEvents 
Axis.LoadPgm All, "MAIN" 

DoEvents 
Axis. PgmRun All 

DoEvents 



End Sub 

Public Sub ApiSetDrives (Setup As Integer) 



AxisControl 



' data acquisition and md^^Fi control program 

Public Axis As New ISP 

Const All =255 

Private Status As Long 

' holds the trace results 
Dim x{250) , y (2, 250) 

' number of times to retry communications 
Const Retrys = 5 

' windows sleep function 

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
Public :Sub ApiHeadZohe (Setting, As String) 

QAxis. Change Value 1, "SETTING", Setting 
EndnSub 

Public Sub ApiShoulderZone (Setting As String) 

.'KAxis.ChangeValue 2, "SETTING", Setting 
EHAxis. Change Value 3, "SETTING", Setting 
Ji^Axis.ChangeValue 4, "SETTING", Setting 

En<l:=jSub 

PufiSic Sub ApiWaistZone^(Setting As String) 

=:ba 

^Axis.ChangeValue 5, "SETTING", Setting 

'"'4 

EnlMSub 

Public S\ib ApiHipZone (Setting As String) 

Axis.ChangeValue 6, "SETTING", Setting 

Axis.ChangeValue 7, "SETTING", Setting 

Axis.ChangeValue 8, "SETTING", Setting 

Axis.ChangeValue 9, "SETTING", Setting 

'End Sub 

Public Sub ApiThighZone (Setting As String) 



Axis.ChangeValue 10, "SETTING", Setting 

Axis.ChangeValue 12, "SETTING", Setting 
End Sub 

Public Sub ApiFeet Zone (Setting As String) 

Axis.ChangeValue 14, "SETTING", Setting 

Axis.ChangeValue 16, "SETTING", Setting 

Axis.ChangeValue 18, "SETTING", Setting 

Axis.ChangeValue 20, "SETTING", Setting 



End Sub 



AxisControl - 3 

V which axis to deal 



If Setup = 0 Then 





Axis . ChangeValue 1 , " 


SWE" , 


"1.0" 




DoEvents 








Axis. ChangeValue 2, " 


SWE" , 


"1.0" 




DoEvents 








Axis . ChangeValue 3, " 


SWE" , 


"1.0" 




DoEvents 








Axis ..ChangeValue 4, " 


SWE" , 


"1.0" 




DoEvents 








Axis . ChangeValue 5, " 


SWE" , 


"1.0" 




DoEvents 








Axis . ChangeValue 6 , " 


SWE" , 


"1.0" 




DoEvents 








Axi s . ChangeValue 7 , " 


SWE" , 


"1.0" 




DoEvents, 








Axis ..ChangeValue 8 , 


SWE " , 


"1.0": 




DoEvents 






„_ 


Axis . ChangeValue 9 , " 


SWE" , 


"1.0" 




DoEvents 






•- 


Axi s . ChangeValue 1 0 , 


"SWE", 


"1.0" 




DoEvents 






V Hi 


Axis . ChangeValue 12 , 


" SWE " , 


"1.0" 




DoEvents 






ca 


Axis. ChangeValue 14, 


"SWE" , 


"1.0" 




DoEvents 






Q 


Axis. ChangeValue 16, 


" SWE " , 


"1.0" 




DoEvents 






13 


Axis .ChangeValue 18, 


"SWE" , 


"1.0" 




DoEvents 








Axis .ChangeValue 20, 


"SWE" , 


"1.0" 




' Axis . ChangeValue 13 , 


" SWE" 


, "0.0" 




' Axi s . ChangeValue 1 5 , 


"SWE" 


, "0.0" 




'Axis. ChangeValue 17, 


"SWE" 


, "0.0" 




'Axis. ChangeValue 19, 


"SWE" 


, "0.0" 


Elself Setup = 1 Then \ 








Axis . ChangeValue 1 , 


" SWE " , 


"1.0" 




Axis . ChangeValue 2 , 


" SWE " , 


"1.0" 




Axis . ChangeValue 3 , 


"SWE" , 


II 1 A II 

"1.0" 




Axis .ChangeValue 4, 


" SWE , 


II 1 A II 

"1.0" 




Axis . ChangeValue 5 , 


" SWE", 


"1.0" 




Axis . ChangeValue 6, 


"SWE", 


"1.0" 




Axis . ChangeValue 7 , 


II GTaTT? tl 


II T A 11 




Axis. Change Value 8, 




II T A 11 




Axis. ChangeValue 9, 




II T A II 




Axis. ChangeValue 10, 




II T A II 




Axis. ChangeValue 11, 


"SWE" 


, "1.0" 




Axis . ChangeValue 12 , 


"SWE" 


, "1.0" 




Axis .ChangeValue 14, 


"SWE" 


, "1.0" 




Axis . ChangeValue 16, 


"SWE" 


, "1.0" 




Axi s . ChangeValue 1 8 , 


"SWE" 


, "1.0" 




Axis. Change Value 20, 


"SWE" 


, "1.0" 



AxisControl - 4 



Axis. Change Value "SWE", "1.0" 

Axis. Change Value 15, "SWE", "1.0" 

Axis. Change Value 17, "SWE", "1.0" 

Axis. Change Value 19, "SWE", "1.0" 



End If 



End Sub 

Piiblic Function ApiComplete (Setup As Integer, Task As String) As Long 
Status = 0 
If Setup = 0 Then 

If Axis.FloatValueOf (1, Task) = -1 Then Status = Status Or 1 
DoE vents 

If Axis.FloatValueOf (2, Task) = -1 Then Status = Status Or 2 
DoEventS' 

If Axis.FloatValueOf (3, Task) = -1 Then Status = Status Or 4 
DoE vents 

If Axis.FloatValueOf (4, Task) = -1 Then Status = Status Or 8 
^% DoEvents 

If Axis .FloatValueOf (5, Task) = -1 Then Status = Status Or 16 
"J DoEvents 

^£ If Axis .FloatValueOf (6, Task) = -1 Then Status = Status Or 32 
DoEvents 

If Axis.FloatValueOf (7, Task) = -1 Then Status = Status Or 64 
DoEvents 

If Axis.FloatValueOf (8, Task) = -1 Then Status = Status Or 128 
DoEvents 

:P If Axis.FloatValueOf (9, Task) = -1 Then Status = Status Or 256 
't^ DoEvents 

M If Axis.FloatValueOf (10, Task) = -1 Then Status = Status Or 512 
Q DoEvents 

If Axis.FloatValueOf (12, Task) = -1 Then Status = Status Or 2048 

If Axis.FloatValueOf (13, Task) = -1 Then Home = Home Or 4096 
DoEvents 

If Axis.FloatValueOf (14, Task) = -1 Then Status = Status Or 8192 

• If Axis.FloatValueOf (15, Task) = -1 Then Home = Home Or 16384 
. DoEvents - . . . ' ■ \, ' ■ . , ^ 

If Axis .FloatValueiOf (16, Task) =' -1 Then Status = Status + 32768 
' If Axis.FloatValueOf (17, Task) = -1 Then Home = Home Or 65536 

DoEvents 

If Axis.FloatValueOf (18, Task) = -1 Then Status = Status + &:H20000 

• If Axis.FloatValueOf (19, Task) = -1 Then Home = Home Or &H40000 
DoEvents 

If Axis.FloatValueOf (20, Task) = -1 Then Status = Status + &H80000 
Elself Setup = 1 Then 
End If 

ApiComplete = Status 
End Function 

Public Function ApiStartPos (Setup As Integer) As Single 



Dim fbposd To 20) As Single 



AxisControl - 5 

Dim* tr As Single 
Dim i As Integer 

If Setup = 0 Then 

For i = 1 To 2 0 

f bpos ( i ) =0 
Next i 

For i = 1 To 10 

fbpos(i) = Axis.FloatValueOf (i, "FPOS") 

DoEvents 
Next i 

For i = 12 To 2 0 Step 2 

fbpos(i) = Axis.FloatValueOf (i, "FPOS") 

DoEvents 
Next i 

Elself Setup = 1 Then 

End If 

' get the translation ratio 
X tr = Axis.FloatValueOf (1, "TR") 

yd, I signal div zero error 
^ If tr = 0 Then 



End If 

1=3 ' translate the f bpos • s to inches 
'^4 For i = 1 To 20 
O fbpos(i) = fbpos(i) / tr 

C3 Next i 




End Function 

Public Sub ApiOpenPort ( ) 

Axi s . OpenPor t 1 

ApiReset 
End Sub 

Public S\ib ApiClosePort ( ) 
Axis . ClosePort 



AxisControl - 6 
End Sub 



Piiblic Sub Capture {) 

' holds the results 
Dim x(250) , y (2, 250) 

Dim Axis As Integer 
Dim jup As Integer 
Dim jlow As Integer 

Dim ct As Integer 
Dim ys As Single 
Dim ymin As Single 

' desired axis number 
Axis =1 

what to grab (jup = first set of data, jlow = second set of data) 

0 = analog input (ADCO) 

1 = target position (TPOS) 

2 = target velocity 

3 = target accel 

4 = feedback position 

5 = feedback velocity 

6 = position error 

7 = current reference 

8 = velocity error 
O jup = 4 

jlow = 7 

' total capture time in tenths of a second 
f4 » with ci_desired = 10, capture of 1 second total time 
ci_desired = 100 

' whether (=1) or not (=0) to wait for the "WAIT FOR TRIGGER" step within 
' a program 
trig = 1 

■ capture', the, data . ■ ' ■ ; '/ • , . V: 
GoCap Axis, (ci_desired)* , (jup) , (jlow) , (trig) 

' wait until the data is acquired by the drive 
While Not FinishedCap (Axis) 
DoEvents 

Wend 

' first set of data (250 pts) into y(l,i) 
a = Cap (Axis, 0) 

» a check should be made here to make sure len(a) = 250 
• if not, the data did not make it over. . , 

Yscale Axis, 0, ct, ys, ymin 
If ys = 0 Then ys = 1 

For i = 1 To 250 

x(i) = 0.001 * (i - 1) * ci desired / 2.5 



AxisControl - 7 

yyy = Asc(Mid(a, -^^^B ) 

yd/ i) = yyy / ys^^m\in 

Next i 




' second set of data (250 pts) into y(2,i) 

a = Cap (Axis, 1) 
a check should be made here to make sure len(a) = 250 
if not, the data did not make it over. . . 



Yscale Axis, 1, ct, ys, ymin 
If ys = 0 Then ys = 1 

For i = 1 To 250 

yyy = Asc{Mid{a, i, 1)) 

y(2, i) = yyy / ys + ymin 
Next i 

' done 

Stop 

EndSsub 

PulJiOic Function GoCap(id As Integer, ci As Integer, ct As Integer, ct2 As Integer, trig As Integ 
er^Svs Boolean 

^,ODim i As Integer 
LnDim a As String 

£9 

s For i = 1 To Retrys 

13 

^£If (trig = 0) Then 

[H Axis.SendPacket (id), Chr(ll) + Chr(ci) + Chr(ct) + Chr(ct2) 
^jElse 

Axis.SendPacket (id), Chr(24) + Chr{ci) + Chr(ct) + Chr(ct2) 
^^End If 

a = Axis.GetPacket (1) 

If a <> Then 

GoCap = True 

■■. ■ Exit Function :V ''^ . . ' ]' 

■ End If" ' ■ ■ ■ ■ ■ ^ ■ 

Next i 

GoCap = False 
End Function 

Function FinishedCap (id As Integer) As Boolean 
FinishedCap = False 

If Axis. Status (id) And 256 Then FinishedCap = True 
End Function 

Public Function Cap (id As Integer, thetype As Integer) As String 



Dim i As Integer 
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For i = 1 To Retrys 

Axis.SendPacket (id) , Chr(13) + Chr(thetype) 
Sleep 100 

Cap = Axis .GetPacket (250) 
If Cap <> Then 
Exit Function 
End If 

Next i 

Cap = 

End Function 

Public Function Yscaledd, which, ByRef captype As Integer, ByRef ys As Single, ByRef ym As Sing 
le) As Boolean 

Dim i As Integer 

„„Dim a As String 

O 

}^^Yscale = False 
==pTn = 0 

%ypor i = 1 To Retrys 

E.fl 

COaxIs .SendPacket (id), Chr(12) + Chr(which) 
2=^Sleep 50 

Pa = Axis. Get Packet (0) 
CSif a <> Then 

M captype = Asc(Left(a, 1) ) - 1 
p a = Mid(a, 2) 
□ i = InStr{a, ") 
If i <> 0 Then 

Yscale = True 
ys = VaKLeft (a, i - 1) ) 
ym = Val(Mid(a, i + 1) ) 
End If 

''■ 'Yscale = True ■■ ■ ' ' ■ ■ ' 

Exit Function ' ' ' * " • . :* 

End If 

Next i 




End Function 
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************* 



'* Copyright (c) 1998, KL GROUP INC. All Rights Reserved. 
' * ht tp : / /www . klg . com 

•* This file is provided for demonstration and educational uses only. 
'* Permission to use, copy, modify and distribute this file for 
'* any purpose and without fee is hereby granted, provided that the 
' * above copyright notice and this permission notice appear in all 
•* copies, and that the name of KL Group not be used in advertising 
'* or publicity pertaining to this material without the specific, 
' * prior written permission of an authorized representative of 
' * KL Group . 



'* KL GROUP MAKES NO REPRESENTATIONS OR WARRANTIES ABOUT THE SUITABILITY 

•* OF THE SOFTWARE, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED 

'* TO THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 

'* PURPOSE, OR NON- INFRINGEMENT. KL GROUP SHALL NOT BE LIABLE FOR ANY 

'* DAMAGES SUFFERED BY USERS AS A .RESULT OF USING, MODIFYING OR ■ 

'* DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES . 

I********************************************* 

o 

'THSs file contains a list of colors that can be used 
' in any VB program. These colors can also be found in 
' tifie property pages of the Olectra Chart controls . 

'Thi HEX values can also be broken down into their 

' Rsd Green Blue (RGB) equivalents by breaking the number 

• e^wn by pairs of digits . Here is an example : 
' ~" ocColorTurquoise = &HD0E040 

• n Red = &HDO (208), Green = &HEO (224), Blue = &H40 (64) 

' opDef aultColor is the same as "(Automatic)" in the property pages 
Public Const ocDef aultColor As Long = &HFFFF 

Pu|d-ic Const ocColorAliceBlue As Long = &HFFF8F0 
PuMic Const ocColorAntiqueWhite As Long = &HD7EBFA 
Public Const oc Co lor Aquamarine As Long = ScHD4FF7F 
Public Const ocColorAzure As Long = &:HFFFFFO 
Public Const ocColorBeige As Long = &HDCF5F5 
Public Const ocColorBisque As Long - &HC4E4FF 

Public Const ocCTblorBlack As Long = &H0 ■ , . / - 

Public Const ocColorEiianchedAlmond As Long = &HCDEBFF 

Public Const ocColorBlue As Long = &HFFOOOO 

Public Const ocColorBlueViolet As Long = &HE22B8A 

Public Const ocColorBrown As Long = &H2A2AA5 

Public Const ocColorBurlywood As Long = &H87B8DE 

Public Const ocColorCadetBlue As Long = &iIA09E5F 

'ocColorChartreuse As Long = &H00FF7F 

'The above would be true, but Visual Basic removes the leading zeros 
Public Const ocColorChartreuse As Long = 654 07 

Pi±>lic Const ocColorChocolate As Long = &H1E69D2 

Public Const ocColorCoral As Long = &H507FFF 

Public Const ocColorCornf lowerBlue As Long = &HED9564 

Public Const ocColorCprnsilk As Long = &HDCF8FF 

Public Const ocColorCyan As Long = &HFFFFOO 

Public Const ocColorDarkGoldenrod As Long - &HB86B8 
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' ocColorDarkGreen As Long 

'The above would be true, bu^Visual Basic removes the leading "zeros 
Public Const ocColorDarkGreen As Long = 25600 

Public Const ocColorDarkKhaki As Long = &H6BB7BD 
Pi±>lic Const ocColorDarkOliveGreen As Long = &H2F6B55 
Public Const ocColorDarkOrange As Long = &H8CFF 
Public Const ocColorDarkOrchid As Long = &HCC3299 
Public Const ocColorDarkSalmon As Long = &H7A96E9 
Public Const ocColorDarkSeaGreen As Long = &H8FBC8F 
Public Const ocColorDarkSlateBlue As Long = &H8B3D48 
Public Const ocColorDarkSlateGray As Long = .5cH4F4F2F 
Public Const ocColorDarkTurquoise As Long = SJIDICEOO 
Pxiblic Const ocColorDarkViolet As Long - &HD3 0094 
Public Const ocColorDeepPink As Long = &H9314FF 
Public Const ocColorDeepSkyBlue As Long = &HFFBFOO 
Public Const ocColorDodgerBlue As Long = &HFF901E 
Public Const ocColorFirebrick As Long = &H2222B2 
Public Const ocColorFloralWhite As Long = &HF0FAFF 
Public Const ocColorForestGreen As Long = &H228B22 
Piiblic Const ocColorGainsboro As Long = fiJIDCDCDC 
Public Const ocColorGhostWhite As Long = &HFFF8F8 

'ofeSolorGold As Long = &H00D7FF 

'Tlfl above would be true, but Visual Basic removes the leading zeros 
Puk3-ic Const ocColorGold As Long = 55295 

Pui2.ic Const ocColorGoldenrod As Long = &H20A5DA 

Publ-ic Const ocColorGray As Long = ScHBEBEBE 

PufSLic Const ocColorGrayO As Long = fiJiO 

Public Const ocColorGrayl As Long =. fitH30303 

PuSp-ic Const ocColorGray2 As Long = &H50505 

Pi4g.ic Const ocColorGray3 As Long = SJi80808 

Pi^l^ic Const ocColorGray4 As Long = &HAOAOA 

P\ab|.ic Const ocColorGray5 As Long = &HDODOD 

Putofic Const ocColorGrayG As Long = &HFOFOF 

PuH-ic Const ocColorGray? As Long = &H121212 

Pv^Diic Const ocColorGray8 As Long = &H141414 

Public Const ocColorGray9 As Long = &H171717 



Public 


Const 


ocColorGraylO 


As 


Long 




&H1A1A1A 


Public 


Const 


ocColorGrayll 


As 


Long 




&H1C1C1C 


Public 


Const 


ocColorGrayl2 


As 


Long 




&H1F1F1F 


Public 


Const 


bcColorGrayl3 


As 


Long 




&H21212:L 


Public 


Const 


ocColorGrayl4 


As 


Long 




&H242424 


Public 


Const 


ocColorGraylS 


As 


Long 




&H262626 


Public 


Const 


ocColorGrayl6 


As 


Long 




&H292929 


Public 


Const 


ocColorGrayl7 


As 


Long 




&H2B2B2B 


Public 


Const 


ocColorGraylS 


As 


Long 




&H2E2E2E 


Public 


Const 


ocColorGrayl9 


As 


Long 




&H303030 


Public 


Const 


ocColorGray2 0 


As 


Long 




&H333333 


Public 


Const 


ocColorGray21 


As 


Long 




&H363636 


Public 


Const 


ocColorGray22 


As 


Long 




&H383838 


Public 


Const 


ocColorGray23 


As 


Long 




&H3B3B3B 


Public 


Const 


ocColorGray24 


As 


Long 




&H3D3D3D 


Public 


Const 


ocColorGray25 


As 


Long 




&H404040 


Public 


Const 


ocColorGray26 


As 


Long 




&H424242 


Pxiblic 


Const 


ocColorGray27 


As 


Long 




&H454545 


Public 


Const 


ocColorGray28 


As 


Long 




&H474747 


Public 


Const 


ocColorGray29 


As 


Long 




&H4A4A4A 


Public 


Const 


ocColorGray30 


As 


Long 




&H4D4D4D 


Public 


Const 


ocColorGray3 1 


As 


Long 




&H4F4F4F 
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Public 


Const 


ocColorGray32^ 




fLong 


= 


&H525252 


Public 


Const 


ocColorGray33 




Long 


= 


&:H545454 


Public 


Const 


ocColorGray34 


As 


Long 


= 


&H575757 


Piiblic 


Const 


ocColorGray3 5 


As 


Long 


= 


&H595959 


Public 


Const 


ocColorGray36 


As 


Long 




&H5C5C5C 


Public 


Const 


ocColorGray37 As 


Long 


= 


&H5E5E5E 


Piiblic 


Const 


ocColorGray3 8 


As 


Long 


= 


&H616161 


Public 


Const 


ocColorGray39 


As 


Long 




&H636363 


Public 


Const 


ocColorGray4 0 


As 


Long 


= 


&H666666 


Public 


Const 


ocColorGray41 As 


Long 


= 


&H696969 


Public 


Const 


ocColorGray42 


As 


Long 


= 


&H6B6B6B 


Public 


Const 


ocColorGray4 3 


As 


Long 


= 


&H6E6E6E 


Public 


Const 


ocColorGray44 


As 


Long 




&H707070 


Public 


Const 


ocColorGray4 5 


As 


Long 


= 


&H737373 


Piiblic 


Const 


ocColorGray4 6 


As 


Long 


= 


&:H757575 


Public 


Const 


ocColorGray47 


As 


Long 




&:H787878 


Public 


Const 


ocColorGray4 8 


As 


Long 




ScH7A7A7A 


Public 


Const 


ocColorGray49 


As 


Long 


= 


6cH7D7D7D 


Public 


Const 


ocColorGrayBO 


As 


Long 




&:H7F7F7F 


Public 


Const 


ocColorGray 5 1 


As 


Long 




&H828282 


Public 


Const 


ocColorGray52 


As 


Long 




£cH858585 


Public 


Const 


ocColorGray53 


As 


Long 


= 


&H878787 


Pu)||jic 


Const 


ocColorGray54 


As 


Long 


= 


&:H8A8A8A 


Pub'Eic 


Const 


ocColorGraySS 


As 


Long 


= 


ScH8C8C8C 


Pub'Siic 
Public 


Const 


ocColorGray56 As 


Long 




&H8F8F8F 


Const 


ocColorGrayS? As 


Long 


- 


&:H919191 


PubEic 


Const 


ocColorGray58 


As 


Long 


= 


&H949494 


Public 


Const 


ocColorGray59 As 


Long 


= 


&H969696 


PuljEic 

s ; 3 


Const 


ocColorGray6 0 


As 


Long 


= 


&H999999 


Pu]|j;ic 


Const 


ocColorGray61 As 


Long 


= 


&H9C9C9C 


PullJic 


Const 


ocColorGray62 


As 


Long 




&:H9E9E9E 


Pulliic 


Const 


ocColorGray63 


As 


Long 




&HA1A1A1 


Piiii^ic 


Const 


ocColorGray64 


As 


Long 




&:HA3A3A3 


PuBtic 


Const 


ocColorGray65 


As 


Long 




&HA6A6A6 


s — 3 

Piibiic 


Const 


ocColorGrayS 6 


As 


Long 




&HA8A8A8 


Public 


Const 


ocColorGray67 


As 


Long 


= 


&HABABAB 


Public 


Const 


ocColorGray68 As 


Long 


= 


&HADADAD 


Puilic 


Const 


ocColorGray69 As 


Long 


= 


ficHBOBOBO 


Public 


Const 


ocColorGray 7 0 


As 


Long 




&HB3B3B3 


Public 


Const 


ocColorGray71 


As 


Long 


= 


&HB5B5B5 


Public 


Const 


ocColorGray72 


As 


Long 




&HB8B8B8 


Public 


Const 


ocColorGray73 


As 


Long 




&HBABABA 


Public 


Const 


ocColorGray74 


, As 


Xong 




&HBDBDBD 


Piiblic 


Const 


ocColorGray75 


As 


Long 


= 


&HBFBFBF 


Public 


Const 


ocColorGray76 


As 


Long 




&HC2C2C2 


Public 


Const 


ocColorGray77 


As 


Long 


= 


&HC4C4C4 


Public 


Const 


ocColorGray78 


As 


Long 




&HC7C7C7 


Public 


Const 


ocColorGray79 


As 


Long 




&HC9C9C9 


Public 


Const 


ocColorGraySO 


As 


Long 


= 


&HCCCCCC 


Public 


Const 


ocColorGrayS 1 


As 


Long 


= 


&HCFCFCF 


Public 


Const 


ocColorGray82 


As 


Long 




&HD1D1D1 


Public 


Const 


ocColorGray83 


As 


Long 


= 


&HD4D4D4 


Public 


Const 


ocColorGray84 


As 


Long 


= 


&HD6D6D6 


Public 


Const 


ocColorGray85 


As 


Long 


= 


&HD9D9D9 


Public 


Const 


ocColorGray86 


As 


Long 




&HDBDBDB 


Public 


Const 


ocColorGrayS 7 


As 


Long 




&HDEDEDE 


Public 


Const 


ocColorGray88 


As 


Long 




&HEOEOEO 


Public 


Const 


ocColorGray89 


As 


Long 


— 


&HE3E3E3 


Public 


Const 


ocColorGray90 


As 


Long 




&HE5E5E5 


Public 


Const 


ocColorGray91 


As 


Long 




&HE8E8E8 


Public 


Const 


ocColorGray92 


As 


Long 




ficHEBEBEB 
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Public tonst ocColorGray93 
Public Coiist ocColorGray94 "SI 
Public Const ocColorGray95 As 
Public Const ocColorGray96 As 
Piiblic Const ocColorGray97 As 
Public Const ocColorGray98 As 
Public Const ocColorGray99 As 



iLong 
Long 
Long 
Long 
Long 
Long 
Long 



&HEDEDED 
&HFOFOFO 
&HF2F2F2 
&HF5F5F5 
&HF7F7F7 
&HFAFAFA 
&HFCFCFC 



' ocColorGreen As Long = &HOOFFOO 

•The above would be true, but Visual Basic removes the leading zeros 
Piiblic Const ocColorGreen As Long = 65280 

Public Const ocColorGreenYellow As Long = &H2FFFAD 
Public Const ocColorHoneydew As Long = &HFOFFFO 
Public Const ocColorHotPink As Long = &HB469FF 
Public Const ocColorlndianRed As Long = &H5C5CCD 
Public Const ocColorlvory As Long = &HFOFFFF 
Public Const ocColorKhaki As Long = &H8CE6F0 
Public Const ocColorLavender As Long - &:HFAE6E6 
Public Const ocColorLavenderBlush As Long = &HF5F0FF 



' ocColorLawnGreen As Long = &H00FC7C 

'The, above would be true, but Visual Basic removes the leading zeros 
Pxib^c Const ocColorLawnGreen As Long = 64636 

in 

Pubiic Const ocColorLemonChif f on As Long = &HCDFAFF 
Public Const ocColorLightBlue As Long = &HE6D8AD 
PuiD^ic Const ocColorLightCoral As Long = &H8080F0 
Pub^ific Const ocColorLightCyan As Long = £^FFFFEO 
Pioliilc Const ocColorLightGoldenrod As Long = &H82DDEE 
PulJ^ific Const ocColorLightGoldenrodYellow As Long = &HD2FAFA 
Pulflic Const ocColorLightGray As Long = &HD3D3D3 
PuljSic Const ocColorLightPink As Long = &HC1B6FF 
Piibfic Const ocColorLightSalmon As Long = &H7AA0FF 
Piibflic Const ocColorLightSeaGreen As Long = &HAAB220 
PulMlc Const ocColorLightSkyBlue As Long = &HFACE87 
PuSSic Const ocColorLightSlateBlue As Long = &HFF7084 
PutCSic Const ocColorLightSlateGray As Long = fi£H998877 
Public Const ocColorLightSteelBlue As Long = &HDEC4B0 
Public Const ocColorLightYellow As Long = &HEOFFFF 
Piiblic Const ocColorLimeGreen As Long = &H32CD32 
Public Const ocColorLinen As Long = &HE6F0FA 
Public Const ocColorMagenta As Long = &HFFOOFF , 
Public Const ocColorMaroon As Long = &H6030B0 
Public Const ocColorMediumAquamarine As Long = &HAACD66 
Public Const ocColorMediumBlue As Long = &HCDOOOO 
Public Const ocColorMediumOrchid As Long = &HD355BA 
Public Const ocColorMediumPurple As Long = &HDB7093 
Public Const ocColorMediumSeaGreen As Long = &H71B33C 
Public Const ocColorMediumSlateBlue As Long = &HEE687B 
Public Const ocColorMediumSpringGreen As Long = &H9AFA00 
Public Const ocColorMediumTurquoise As Long = &HCCD148 
Public Const ocColorMediumVioletRed As Long = &H8515C7 
Public Const ocColorMidnightBlue As Long = &H7 01919 
Public Const ocColorMintCream As Long = &HFAFFF5 
Public Const ocColorMistyRose As Long = &HE1E4FF 
Public Const ocColorMoccasin As Long = &HB5E4FF 
Public Const ocColorNavajoWhite As Long = &HADDEFF 
Public Const ocColorNavyBlue As Long = &H800000 
Public Const ocColorOldLace As Long = &HE6F5FD 
Public Const ocColorOliveDrab As Long = &H238E6B 
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' ocColorOrange As Long = &T!wl)A5FF 
'The above would be true, but Visual Basic removes the leading zeros 
Public Const ocColorOrange As Long = 42495 

' ocColorOrangeRed As Long = &:H0045FF 

'The above would be true, but Visual Basic removes the leading zeros 
Public Const ocColorOrangeRed As Long - 17919 

Public Const ocColorOrchid As Long = &HD670DA 
Public Const ocColorPaleGoldenrod As Long = &HAAE8EE 
Public Const ocColorPaleGreen As Long = &H98FB98 
Public Const ocColorPaleTurquoise As Long = &HEEEEAF 
Public Const ocColorPaleVioletRed As Long = &H9370DB 
Public Const ocColorPapayaWhip As Long = &HD5EFFF 
Public Const ocColorPeachPuf f As Long = &:HB9DAFF 
Public Const ocColorPeru As Long = &H3F85CD 
Public Const ocColorPink As Long = &HCBCOFF 
Public Const ocColorPlum As Long = &HDDAODD 
Pxiblic Const ocColorPowderBlue As Long = &HE6E0B0 
Public Const ocColorPurple As Long = &HF020A0 
Piablic Const ocColorRed As Long = &HFF 
PuS-ic Const ocColorRosyBrown As Long = &H8F8FBC 
PTil&ic Const ocColorRoyalBlue As Long = &HE16941 
PiMkic Const ocColorSaddleBrown As Long = &H13458B 
Pi^pLic Const ocColorSalmon As Long = &H7280FA 
P\:ySLic Const ocColorSandyBrown As Long = &H60A4F4 
PiitSLic Const ocColorSeaGreen As Long = &H578B2E 
P\#lLic Const ocColorSeashell As Long = &HEEF5FF 
P\ffl.ic Const ocColorSienna As Long = &H2D52A0 
Pi:^lic Const ocColorSkyBlue As Long = &HEBCE87 
Pi^lgLic Const ocColorSlateBlue As Long = ScHCDSAGA 
PugLic Const ocColorSlateGray As Long = &H908070 
Piiglic Const ocColorSnow As Long = ScHFAFAFF 
Piibp-ic Const ocColorSpringGreen As Long = &H7FFF00 
Pufe^lic Const ocColorSteelBlue As Long = &HB48246 
PiiSlic Const ocColorTan As Long = &H8CB4D2 
Pi:^lic Const ocColorThistle As Long = &HD8BFD8 
Public Const ocColorTomato As Long = &H4763FF 
Piiblic Const ocColorTurquoise As Long = &HD0E040 
Public Const ocColorViolet As Long = &HEE82EE 
Public Const ocColorVioletRed As Long = &H9020D0 
Public Const. ocColorWheat As Long ,= &HB3DEF5 
Public Const ocColorWhite As Long = &HFFFFFF 

'ocColorYellow As Long = &HOOFFFF 

'The above would be true, but Visual Basic removes the leading zeros 
Public Const ocColorYellow As Long = 65535 

Public Const ocColorYellowGreen As Long = &H32CD9A 
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Option Explicit 
Dim fsa_cb As Integer 
Dim fsa_is As Integer 
Dim fsa_bf As Integer 
Dim fsa_tf As Integer 
Dim fsa_ss As Integer 

Dim PSW As Double 
Dim PHW As Double 



Dim Barray(0 To 2000) As Long 
Dim NewData As Variant 

'Storage for easier reference later 
Dim NumRows As Long 
Dim NumColumns As Long 
Dim S index As Long 

Dim XI As Double , 
Dim X2 As Double 
Dim x3 As Double 
Difii3x4 As Double 
DiiOxS As Double 
Diffllx6 As Double 
DiHpx? As Double 
Dir£x8 As Double 

DiiSxS As Double 

if? 

Di@0 SpineData As Double 

Dim Stopit As Integer 
DirgHead As Integer 
DifQ Feet As Integer 
' Gjass dim 

PioMic FSASum As Double 
PioMic FSAAverage As Double 
PuMic FSASensors As Long 
Public TorsoAverage As Double 
Public TorsoSensors As Integer 
Public ShoulderAverage As Double 
Dim ShoulderWidth As Double 
Public HipAverage As Double 
Public WaistAverage As Double 
Dim HipMaxWidth As Double 
Dim WAverageWidth As Double 
Public FSAWeight As Doiible 
Dim FSAHeight As Double 
Dim FSAI spring As Double 
Dim TorsoLength As Double 
Dim datacall As Long 

Public Function Put_FSAData (ByVal element As Long, ByVal index As Long) As Double 

Dim i As Integer 
Dim X As Double 
On Error Resume Next 
Put FSAData = -1 




If index < 0 Then Exit Function 
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If index > 2 000 Then ^^||| Function 
NewData = True 
X = 0 

Barray (index) = element 

If element Then datacall = datacall + 1 

For i = 0 To index 

X = X + Barray (i) 
Next i 

Put_FSAData = x 
End Function 



Public Property Get CBcoef {) As Variant 
On Error Resume Next 
If NewData Then 
Call Crunchit 
Q NewData = False 
.'□End If 

m CBcoef = f sa_cb 
En^^ Property 

a: ; 

Pu&ic Property Get IScoef () As Variant 
On Error Resume Next 

If NewData Then 
Call Crunchit 
NewData = False 
HEnd If 

^ IScoef = f sa_is 

Enjt' Property 

r 3 

Public Property Get BFcoef () As Variant 
On Error Resume Next 

If NewData Then. 

Call Crunchit 

NewData = False 
End If 

BFcoef = fsa_bf 
End Property 



Public Property Get TFcoef () As Variant 
On Error Resume Next 

If NewData Then 

Call Crunchit 

NewData = False 
End If 

TFcoef = fsa_tf 
End Property 
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Public Property Get SSprof (^^B Variant 
On Error Resume Next 

If NewData Then 

Call Crunchit 

NewData = False 
End If 

SSprof = fsa_ss 
End Property 

Private Sub Crunchit () 

Dim r As Integer 

Dim c As Integer 

Dim RAv As Double 

Dim avrav As Double 

Dim InARow As Integer 

Dim TorsoBottom As Integer 

Dim TorsoTop As Integer 
• Dim TorsoLeft As Integer. 

Dim TorsoRight As Integer 

Dim Brow As Integer 

Dim HipSum As Double 

Dim WaistSum As Doiible 

Dim HipSensors As Integer 

Dim WB'irst As Integer 
*J Dim WLast As Integer 
"J Dim Last InARow As Integer 

Dim ShoulderSum As Double 

Dim ShoulderSensors As Integer 
'^^ Dim SLast As Integer 
7_ Dim SFirst As Integer 
O Dim Stretch As Integer 
*F Dim WaistSensors As Integer 
P Dim DTemp As Double 
''4 Dim TorsoCenter As Double 
□ Dim f sa As Integer 
p Dim Center As Integer 

Dim Cfirst As Integer 

Dim darray(32, 32) As Double 

Dim delta As Double 

Dim Zeros As Integer 

Dim MCoeif As Double 

Dim FCoef As Double 

Dim J As Double 

Dim Ul(l To 9) As Double 

Dim U2(l To 9) As Double 

Dim 21(1 To 9) As Double 

Dim Zl_2(l To 9) As Doxible 

Dim Z2(l To 9) As Doiible 

Dim Z2_2(l To 9) As Double 

Dim Z1_Z2(1 To 9) As Double 

Dim Yl(l To 9) As Double 

Dim SumU2 As Double 
Dim SumZl_2 As Double 
Dim SumZ2_2 As Double 
Dim SumZl_Z2 As Dovible 
Dim SumYl_Zl As Doiible 
Dim SumYl_Z2 As Double 
Dim divisor As Double 
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Dim S As Double 
Dim Lumbar As Double 

Dim CDatad To 32, 1 To 32) 
Dim UnitMultiplier As Doiible 

On Error Resume Next 

UnitMultiplier = 0.392156862745098 

fsa = 0 
FSASum = 0 
FSASensors = 0 

NumColumns =32 
NumRows = 32 

For c = 1 To NumColumns 
For r = 1 To NumRows 

DTemp = Barray{fsa) * UnitMultiplier 
CData(c, r) = DTemp 
If DTemp < 50 Then 
If DTemp Then 

FSASum = FSASum + DTemp 
FSASensors = FSASensors + 1 
End If 
End If 

fsa = fsa + 1 
Next r 

^^Next c 

=Plf FSASensors = 0 Then GoTo error_out 

''""4 ' Standard stat stuff 
C3 FSAAverage = FSASum / FSASensors 

FSAWeight = FSASum * 0.03 

• if the person is less than 80 lbs - abort 
If FSAWeight < 80 Then GoTo error_out 

'let's have a swipe at some more stats 
' ie height, hips, waist, & shoudlers 



'set up first cb factor.. 

fsa_cb = FSAWeight * 3.5 
If FSAWeight < 200 Then fsa_cb = 2 
If FSAWeight < 150 Then fsa_cb = 1 

Stopit = False 
For c = 1 To NumColumns 
For r = 1 To NumRows 

If CData(c, r) Then Stopit = True 
If Stopit Then Exit For 
Next r 

If Stopit Then Exit For 
Next c 
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Head = c 

Stopit = False 
For c - NumColumns To 1 Step -1 
For r = NumRows To 1 Step -1 

If CData{c, r) Then Stopit = True 
If Stopit Then Exit For 
Next r 

If Stopit Then Exit For 
Next c 

Feet = c 

FSAHeight = (2 + (Feet - Head)) * 2 

If FSAAverage = 0 Then GoTo error_out 

FSAI spring = FSAWeight / FSAAverage 

fsa_is = FSAIspring * 100 

' If FSAIspring < 8.5 Then fsa_is = 2 
' ^= If FSAIspring < 6.5 Then fsa_is = 1 

in 'Find the "TorsoBottom" for use in calculations 
=Hstopit = False 

"■•H-For c = NumColumns - 5 To 1 Step -1 
^3 For r = 1 To NumRows 
Wl If CData{c, r) Then 

SO InARow = InARow + 1 

s If InARow > 12 Then Stopit = True 

Q Else: 
£ InARow = 0 

Q End If 

M If Stopit Then 

O Exit For 

f5 End If 

Next r 

If Stopit Then Exit For 
Next c 

TorsoBottom - c +. 1 

Center = 0 

Cfirst = 0 

Stopit = False 

For r = 1 To NumRows 

If CData(c, r) Then 

Center = Center + 1 
If Cfirst = 0 Then Cfirst = r 
End If 
Next r 



TorsoCenter = Cfirst + Center / 2 

*Find the "TorsoTop" for use in caluculations 

Stopit = 0 

For c = TorsoBottom - 10 To 1 Step -1 
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If c > 32 Then Go^^Brror_out 

If c < 1 Then GoTo error_out 
For r = 1 To NumRows 

If CData{c, r) Then 

InARow = InARow + 1 

If InARow < Stopit Then Stopit = InARow 
Else: InARow = 0 
End If 
Next r 

If Stopit < 5 Then Exit For 
Stopit = 0 
Next c 

If c < 1 Then c = 1 
TorsoTop = c 

»Now that we have located TorsoBottom and TorsoTop 

'Find the shoulder width by slicing, the torso data lengthwise 

'From the Right: 



l:F1 



For r = 1 To NumRows / 2 

For c = TorsoTop To TorsoTop + 3 
If c > 32 Then GoTo error_out 
If c < 1 Then GoTo error_out 
If CData(c, r) Then 

InARow = InARow + 1 
t1 If InARow > 1 Then Exit For 

- Else: 

' InARow = 0 
End If 
Next c 

^=^" If InARow > 1 Then Exit For 

"-^ Next r 

iJ TorsoRight = r 



'From the Left; 

For r - NumRows To NumRows / 2 Step -1 
For c = TorsoTop To TorsoTop + 3 ; 
if c > 32 Then GoTb error_out 
If c < 1 Then GoTo error_out 
If CData(c, r) Then 

InARow = InARow + 1 

If InARow > 1 Then Exit For 

Else: InARow = 0 

End If 

Next c 

If InARow > 1 Then Exit For 
Next r 

TorsoLeft = r 



ShoulderWidth = {(TorsoLeft - TorsoRight) * 0.75) + 3 



Brow = TorsoBottom - 4 
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'Hip Sc Waist 

LastlnARow = 
InARow = 0 
WFirst = 0 
WLast = 0 

HipSum = 0 
WaistSum = 0 
HipSensors = 0 
HipMaxWidth = 0 
HipAverage = 0 
Wai s t Ave rage = 0 
WAverageWidth = 0 
WaistSensors = 0 

' Dim ct As Integer 

For c = Brow To Brow +4 

:For r = Cfirst To NumRows 

If CData{c, r) Then 

HipSum = HipSum + CData(c, r) 
HipSensors = HipSensors + 1 
InARow = InARow + 1 
If InARow > LastlnARow Then 

LastlnARow = InARow 
End If 
Else: InARow = 0 
End If 



If c - 6 < 1 Then GoTo error_out 
If CData(c - 6, r) Then 

WaistSum = WaistSum + CData(c - 5, r) 
WaistSensors = WaistSensors + 1 

End If 

If c - 5 < 1 Then GoTo error_out 
If CData(c - 5, r) Then 

. If WFirst = 0 Then WFirst. = r; 
WLast = r 
End If 
Next r 

WAverageWidth = WAverageWidth + (WLast - WFirst) * 0 
WFirst = 0 
Next c 



If HipSensors = 0 Then HipSensors = HipSensors + 1 

If WaistSensors = 0 Then WaistSensors = WaistSensors + 1 

HipMaxWidth = LastlnARow * 0.75 
HipAverage = HipSum / HipSensors 
WaistAverage = WaistSum / WaistSensors 
WAverageWidth = WAverageWidth / 4 



average 



• 
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•Shoulder average 

ShoulderSum = 0 
ShoulderSensors = 0 
ShoulderAverage = 0 
SFirst = 32 
SLast = 0 
Stretch = 0 
InARow = 0 

For c = TorsoTop To TorsoTop + 3 
If c > 32 Then GoTo error_out 
If c < 1 Then GoTo error_out 

For r = TorsoRight To TorsoLeft 
If r > 32 Then GoTo error_out 
If r < 1 Then GoTo error_out 
If CData(c, r) Then 

ShoulderSum = ShoulderSum + CData(c, r) 
ShoulderSensors = ShoulderSensors + 1 

End If 
,B Next r 
s'PgNext c 

a 

•glf ShoulderSensors = 0 Then GoTo error_out 
=ishoulderAverage = ShoulderSum / ShoulderSensors 

= = a 

CO 

^^'^TorsoAverage = 0 

™TorsoSensors = 0 

IJ' Calculate the average for the entire torso 

C3For c = TorsoTop To TorsoBottom 
Q If c > 32 Then GoTo error_out 
If c < 1 Then GoTo error_out 
For r = TorsoRight To TorsoLeft 
If r > 32 Then GoTo error_out 
If r < 1 Then GoTo error_out 
. . 'if CData {c, r) , < . 80; Then ,- . / ^ - ■ 

If CData(c, r) Then 

TorsoAverage = TorsoAverage + CData(c, r) 
TorsoSensors = TorsoSensors + 1 
End If 
End If 
Next r 
Next c 

If TorsoSensors = 0 Then GoTo error_out 
TorsoLength = (TorsoBottom - TorsoTop) * 2 
TorsoAverage = TorsoAverage / TorsoSensors 

'Predicted (Shoulder Width) /Weight = 0.14538 - 0 , 00000613* (Total mmHg) 
'0.0007852* (Average) - 0 . 0005343* (SWidth) - 0 . 0007978* (TLength) 



'Predicted (Hip Width) /Weight = 0.12607 +13 . 358* (HWidth/Total mmHg) - 
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' 0 .0009497* (SWidth) -^^020362* (UWidth) - 0 . 00153 09* (TLlMfh) 




' PSW = 0.14538 - 0.00000613 * FSASum + 0.0007852 * FSAAverage - 0.0005343 * ShoulderWidth - 
0.0007978 * TorsoLength 

' PHW = 0.12607 + 13.358 * (HipMaxWidth / FSASum) - 0.0009497 * ShoulderWidth - 0.0020362 * H 
ipMaxWidth - 0.0015309 * TorsoLength 

PSW = 1 / (PSW + PHW) 



fsa_bf = (((FSAWeight / ShoulderWidth) + (FSAWeight / HipMaxWidth)) / 2) * 45 

fsa_bf = (ShoulderAverage + HipAverage) * 10 

If PSW < 7.5 Then fsa_bf = 3 
If PSW < 6.5 Then fsa^bf =2 
If PSW < 5.5 then fsa bf = 1- 



_ Lumbar = WaistAverage 
f sa_tf = Lumbar * 10 

i n 

If Lumbar < 35 Then fsa_tf = 2 
If Lumbar < 25 Then fsa_tf = 1 

in Lumbar = WaistAverage 

CO 

~; fsa__ss = 0 

Q If Lumbar > 15 Then fsa_ss = 1 
If Lumbar > 20 Then fsa_ss = 2 
Q If Lumbar > 23 Then fsa_ss = 3 
ij If Lumbar > 28 Then fsa_ss = 4 
If Lumbar > 32 Then fsa_ss = 5 
™ If Lumbar > 38 Then fsa_ss = 6 
~~ If Lumbar > 42 Then fsa__ss = 7 
If Lumbar > 45 Then fsa_ss = 8 
If Lumbar > 50 Then fsa ss - 9 



GoTo end_sub 

error__out : 

fsa_cb = 0 
fsa_is = 0 
fsa_bf = 0 
fsa_tf = 0 
fsa_ss = 5 

end_sub : 

Exit Sub 



End Sub 
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t************************ *^^^* ***************************** *^^V ************* 
t * 

•* Copyright (c) 1998, KL GROUP INC. All Rights Reserved. 
'* http://www.klg.com 
t * 

'* This file is provided for demonstration and educational uses only. 
'* Permission to use, copy, modify and distribute this file for 
•* any purpose and without fee is hereby granted, provided that the 
'* above copyright notice and this permission notice appear in all 
'* copies, and that the name of KL Group not be used in advertising 
'* or publicity pertaining to this material without the specific, 
'* prior written permission of an authorized representative of 
' * KL Group . 
I * 

'* KL GROUP MAKES NO REPRESENTATIONS OR WARRANTIES ABOUT THE SUITABILITY 
'* OF THE SOFTWARE, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED 
'* TO THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 
•* PURPOSE, OR NON- INFRINGEMENT, KL GROUP SHALL NOT BE LIABLE FOR ANY 
'* DAMAGES SUFFERED BY USERS AS A RESULT OF USING, MODIFYING OR 
•* DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. 
I * 

t ***************************************************************************** 
Option Explicit 

PuigLic Type TRACKER 
[n Original As Boolean 
Linear As Boolean 
En^ Type 

PuMic Type POINTAPI 

^^x As Long 

" y As Long 
EnSz Type 

#lg Win32 Then 

H Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long 
, &|^Val crColor As Long) As Long 

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long 
D Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long 

Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDc As Long) As Lo 

ng 

Public Declare Function Rectangle Lib "gdi32" (ByVal hDc As Long, ByVal XI As Long, ByVal Yl 
As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long 

Public Declare Function SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal' hObject As Long) 
As Long 

Public Declare Function SetR0P2 Lib "gdi32" (ByVal hDc As Long, ByVal nDrawMode As Long) As 

Long 
#Else 

Public Declare Function CreatePen Lib "gdi" (ByVal nPenStyle As Integer, ByVal nWidth As Int 
eger, ByVal crColor As Long) As Integer 

Public Declare Fxinction DeleteObject Lib "gdi" (ByVal hObject As Integer) As Integer 
Public Declare Function GetDC Lib "user" (ByVal hWnd As Integer) As Integer 

Public Declare Function Rectangle Lib "gdi" (ByVal hDc As Integer, ByVal XI As Integer, ByVa 
1 Yl As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer 

Piablic Declare Function ReleaseDC Lib "user" (ByVal hWnd As Integer, ByVal hDc As Integer) A 
s Integer 

Public Declare Function SelectObject Lib "gdi" (ByVal hDc As Integer, ByVal hObject As Integ 
er) As Integer 

Public Declare Function SetR0P2 Lib "gdi" (ByVal hDc As Integer, ByVal nDrawMode As Integer) 
As Integer 
#End If 



VistaFile - 1 



Private FSAType As String 
Private FSAReserve As Long 
Private CalFilel As String 
Private MapFlag As Integer 
Private NumArrays As Integer 
Private Width As Integer 
Private Height As Integer 
Public UnitMultiplier As Doxible 
Private Units As String 
Private Label As String 
Private SizeOf Frame As Long 
Public Numberof Frames As Integer 
Public Junk As String 
Piiblic FSAData(0 To 2000) As Byte 




Sub ReadFile (filename) 

Open filename For Binary Access Read As #1 
FSAType = String (6, " ") 
CalFilel = String (48, " ") 

%DGet #1, 1, FSAType 
iHGet #1, , FSAReserve 
=pGet #1, , CalFilel 
==pGet #1, , MapFlag 
iOlf MapFlag Then 

Co End If 

B 

OGet #1, , NumArrays 

^Get #1, , Width 

□ Get #1, , Height 

MGet #1, , UnitMultiplier 

Units = String (6, " ") 
™ Label = String (32, " ") 
™Get #1, , Units 

Get #1, , Label 

If NumArrays = 2 Then 
End If " 

Get #1, , SizeOf Frame 
Get #1, , Numberof Frames 
Junk = String (10, " ") 
Get #1, , Junk 
FSASum = 0 
FSAWeight = 0 
FSASensors = 0 

For i = 0 To SizeOfFrame - 9 

Get #1, , FSAData(i) 
Next i 

Close #1 
End Sub 

' Sub NextFrame (FileName) 



Open FileName For Binary Access Read As #1 




VistaFile - 2 

' For i = NextFrame To^M|:Frame + SizeOfFrame - 9 

Get #1. i, FSADatau) 
• Next i 

Close #1 
•End Sub 



O 
iO 
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=P 

in 
CO 

□ 
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Q 
Q 
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Option Explicit 

Private Sub CancelButton_Click ( ) 

'call ApiAbort 

Unload Me 
End Sub 

Private Sub ForTn_Load() 

Call ApiCalibrate 
End Sub 

Private Sub OKButton_Click ( ) 

Unload Me 
End Sub 

Private Sub Timerl_Timer ( ) 
Dim Complete As Variant 
Status. Caption = "Calibrating" 
v3 If ProgressBarl .Value = 100 Then 

in 

=>p ProgressBarl .Value = 0 
Timerl. Enabled = False 
%Q Call GetCals 

Lfl Complete = ApiComplete (0 , "CALIBRATE") 

m If Complete = &HAABFF Then 

^. Status. Caption = "Complete" 

Exit Sub 
2 End If 

Timerl .Enabled = True 

.2 End If 

^'"^ ProgressBarl .Value = ProgressBarl .Value + 1 
End Sub 

Private Sub, GetCals {) . . 

Dim i As Integer 
For i = 0 To 19 

* need a good way to filter out unused axes 
» for now - hard code it for back lying 

If i <> 12 And i <> 14 And i <> 16 And i <> 18 And i <> 10 Then 

Textl (i) .Text = Axis . ValueOf (i + 1, "CAL") 

End If 
Next i 




End Sub 
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Option Explicit 



Private Sub OKButton_Click ( ) 

Unload Me 
End Sub 
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Private Sub Accept_Click ( 
Main. Choice = 0 
Unload Me 

End Sub 



€ 



Private Sub Cancel_Click() 

Main. Choice = 1 

Unload Me 
End Sub 
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Private^ Done As Integer 
Private Sub Form_Load ( ) 

Done = False 

Call ApiEstop 

Done = True 
End Sxib 

Private Sub Timerl_TiTner ( ) 

Dim Complete As Long 

If ProgressBarl .Value = 100 Then 

ProgressBarl .Value =0 
Timerl. Enabled = False 

If Done = True Then 

Status. Caption = "Test Complete" 
""^ Unload Me 

^ End If 

pa 

Timerl. Enabled = True 

^flEnd If 

in 

CO ProgressBarl .Value = ProgressBarl .Value 
End Sub 



